home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / iconed1a / iconwrks.bas < prev    next >
BASIC Source File  |  1995-04-26  |  38KB  |  1,013 lines
  1. Attribute VB_Name = "Module2"
  2. Option Explicit
  3. #If Win32 Then
  4.     DefLng H-I 'h=handle, i = sysint
  5. #Else
  6.     DefInt H-I
  7. #End If
  8. Dim HelpFilePath As String
  9.  
  10. ' When either the Editor's colorpalette or the ColorPalette Forms
  11. ' ColorPalette need repainting, this routine is called, passing in
  12. ' the picture control used for the specific colorpalette.
  13. '
  14. Sub Display_Color_Palette(Pic_ColorPalette As Control)
  15. Dim i%
  16.     
  17.     ' The ColorPalettes consist of 3 rows of 16 colors, so to make
  18.     ' is easy to display and to deterine what color is selected when
  19.     ' the ColorPalette is click, we set the Scale of the ColorPalette
  20.     ' to correspond to the number of color rows and columns.
  21.     '
  22.     Pic_ColorPalette.Scale (0, 0)-(16, 3)
  23.  
  24.     ' Display ColorPalette column by column
  25.     '
  26.     For i% = 0 To 15
  27.         '
  28.         ' Display a column of colors
  29.         '
  30.         Pic_ColorPalette.Line (i%, 0)-(i% + 1, 1), Colors(i%), BF
  31.         Pic_ColorPalette.Line (i%, 1)-(i% + 1, 2), Colors(i% + 16), BF
  32.         Pic_ColorPalette.Line (i%, 2)-(i% + 1, 3), Colors(i% + 32), BF
  33.  
  34.         ' Display vertical line to left of current columns to visually
  35.         ' divide the columns, but skip first column, since it is not
  36.         ' needed due to the Border of the color palette.
  37.         '
  38.         If i% Then Pic_ColorPalette.Line (i%, 0)-(i%, 3)
  39.     Next i%
  40.   
  41.     ' Display 2 horizontal lines to visually divide the color rows.
  42.     '
  43.     Pic_ColorPalette.Line (0, 1)-(16, 1)
  44.     Pic_ColorPalette.Line (0, 2)-(16, 2)
  45.  
  46. End Sub
  47.  
  48. ' Displays the entire or any portion of the grid, when the Grid option
  49. ' is active.  The 4 paramaters passed in, X1, Y1, X2, Y2, define the
  50. ' upper left and lower right corners of the area within the maginified
  51. ' Icon that needs the grid displayed.
  52. '
  53. Sub Display_Grid(hDCDest, X1 As Integer, Y1 As Integer, X2 As Integer, Y2 As Integer)
  54. Dim DestX As Integer, DestY As Integer, DestWidth As Integer, DestHeight As Integer
  55.     ' The grid is not displayed if the icon is being viewed at normal
  56.     ' size, so check the current value of the scrollbar.
  57.     '
  58.     If Editor.Scrl_Zoom.Value > Editor.Scrl_Zoom.Min Then
  59.         DestX = X1 * PixelSize
  60.         DestY = Y1 * PixelSize
  61.         DestWidth = (X2 - X1 + 1) * PixelSize
  62.         DestHeight = (Y2 - Y1 + 1) * PixelSize
  63.         BitBlt hDCDest, X1 * PixelSize, Y1 * PixelSize, DestWidth, DestHeight, Editor.Pic_Grid.hDC, DestX, DestY, SRCAND
  64.     End If
  65.  
  66. End Sub
  67.  
  68. ' Whenever a new color is selected for either the left or right mouse
  69. ' button, or the StatusArea needs repainting, this routine is called to
  70. ' display the 4 small color squares at the bottom of the StatusArea
  71. ' which are filled with the current colors selected for the mouse buttons.
  72. '
  73. Sub Display_Mouse_Colors()
  74. Dim Middle As Integer, i As Integer, X1 As Integer, X2 As Integer, Y1 As Integer, Y2 As Integer
  75.  
  76.     ' Calculate the center of the Status bar
  77.     '
  78.     Middle = Editor.Pic_StatusArea.ScaleWidth \ 2
  79.  
  80.     ' Display the 4 color squares
  81.     '
  82.     For i = 0 To 3
  83.         '
  84.         ' The squares are centered within the left and right halfs of the
  85.         ' StatusArea, and the width and height are set equal to the Height
  86.         ' of the Option buttons used to select Left/Right or Screen/Inverse
  87.         ' colors, so we calculate the corners of the the Color squares
  88.         ' based on this information.
  89.         '
  90.         X1 = (i Mod 2) * Middle + (Middle - Editor.Opt_Mouse(i \ 2).Height) \ 2
  91.         X2 = X1 + Editor.Opt_Mouse(i \ 2).Height
  92.         Y1 = Editor.Opt_Mouse(i \ 2).Top
  93.         Y2 = Y1 + Editor.Opt_Mouse(i \ 2).Height
  94.  
  95.         ' Draw the color square
  96.         '
  97.         Editor.Pic_StatusArea.Line (X1, Y1)-(X2, Y2), MouseColors(i), BF
  98.  
  99.         ' Draw a black outline around the square
  100.         '
  101.         Editor.Pic_StatusArea.Line (X1, Y1)-(X2, Y2), BLACK, B
  102.     Next i
  103.         
  104.     ' Set the CurrentY value of the StatusArea back to that of the
  105.     ' location where the Mouse Coordinates are displayed, so this
  106.     ' does not have to be done within each MouseMove event of the
  107.     ' Edit area.
  108.     '
  109.     Editor.Pic_StatusArea.CurrentY = Editor.Pic_Icons(5).Top + Editor.Pic_Icons(5).Height + HIGHLIGHT + 1
  110.  
  111. End Sub
  112.  
  113. ' If a selection has been made, is being made, or a selection is
  114. ' being moved, or the Edit area needs repainting while a selection
  115. ' is active, this routine is called to display or redisplay a
  116. ' rectangle around the current selection.
  117. '
  118. Sub Draw_Selection_Rectangle()
  119. Dim XAdjust As Integer, YAdjust As Integer
  120.  
  121.     ' Set drawing mode to INVERSE since this routine also used to erase
  122.     ' the selection rectangle by simply drawing over the currently displayed
  123.     ' rectangle
  124.     '
  125.     Editor.Pic_Edit.DrawMode = INVERSE
  126.  
  127.     ' To distinguish between a selection and a selection that is
  128.     ' being moved, a Dotted line is used for a selection and a solid
  129.     ' line is used for a selection being moved.
  130.     '
  131.     If MovingSelection Then Editor.Pic_Edit.DrawStyle = SOLID Else Editor.Pic_Edit.DrawStyle = DOT
  132.  
  133.     ' To ensure the entire selection rectangle is visible, the rectangle
  134.     ' is adjusted inward 1 pixel from the right and bottom if the selection
  135.     ' contains either the right most column or bottom most row of pixels.
  136.     '
  137.     If X2Region >= PixelSize * 32 Then XAdjust = 1
  138.     If Y2Region >= PixelSize * 32 Then YAdjust = 1
  139.  
  140.     ' Draw the selection rectangle.
  141.     '
  142.     Editor.Pic_Edit.Line (X1Region, Y1Region)-(X2Region - XAdjust, Y2Region - YAdjust), , B
  143.     Editor.Pic_Edit.DrawStyle = SOLID
  144.  
  145. End Sub
  146.  
  147. ' When the currently selected Icon is changed or a new Icon is
  148. ' loaded into the currently selected Icon, the bitmaps that make
  149. ' of the Icons Mask and Image must be extracted and placed into
  150. ' picture controls where they can easily be edited.
  151. '
  152. Sub Extract_Image_And_Mask(Pic_Ctrl As Control)
  153. #If Win32 Then
  154. Dim IPic As IPicture
  155. Dim icoinfo As ICONINFO
  156. Dim PDesc As PICTDESC
  157. Dim hDCWork
  158. Dim hOldWorkBM
  159. Dim hNewBM
  160. Dim hOldMonoBM
  161.     GetIconInfo Pic_Ctrl.Picture, icoinfo
  162.     hDCWork = CreateCompatibleDC(0)
  163.     hNewBM = CreateCompatibleBitmap(Editor.hDC, 32, 32)
  164.     hOldWorkBM = SelectObject(hDCWork, hNewBM)
  165.     hOldMonoBM = SelectObject(hDCMono, icoinfo.hBMMask)
  166.     BitBlt hDCWork, 0, 0, 32, 32, hDCMono, 0, 0, SRCCOPY
  167.     SelectObject hDCMono, hOldMonoBM
  168.     SelectObject hDCWork, hOldWorkBM
  169.     With PDesc
  170.         .cbSizeofstruct = Len(PDesc)
  171.         .picType = PICTYPE_BITMAP
  172.         .Long1 = hNewBM
  173.     End With
  174.     OleCreatePictureIndirect PDesc, IID_IDispatch, 1, IPic
  175.     Editor.Pic_Mask = IPic
  176.     Set IPic = Nothing
  177.     PDesc.Long1 = icoinfo.hBMColor
  178.     OleCreatePictureIndirect PDesc, IID_IDispatch, 1, IPic
  179.     Editor.Pic_Image = IPic
  180.     DeleteObject icoinfo.hBMMask
  181.     DeleteDC hDCWork
  182. #Else
  183. Dim Lpicon As Long
  184.     ' Get pointer to Icon and prevent Windows form moving it.
  185.     '
  186.     Lpicon = GlobalLock(Pic_Ctrl.Picture)
  187.  
  188.     ' Copy the Icons Mask to Monochrome Bitmap, then copy the MonoBitmap
  189.     ' the the Picture control.
  190.     '
  191.     Editor.Pic_Mask.ForeColor = BLACK
  192.     SetBitmapBits hBMMono, 128, Lpicon + 12
  193.     BitBlt Editor.Pic_Mask.hDC, 0, 0, 32, 32, hDCMono, 0, 0, SRCCOPY
  194.  
  195.     ' Copy Icons Image bitmap to Picture control
  196.     '
  197.     SetBitmapBits Editor.Pic_Image.Image, ImageSize, Lpicon + 12 + 128
  198.  
  199.     ' Free icon so Windows is free to move it.
  200.     '
  201.     GlobalUnlock Pic_Ctrl.Picture
  202. #End If
  203. End Sub
  204.  
  205. ' Displays the selected help topic selected from either
  206. ' Editors;' or Viewer's help menu.
  207. '
  208. Sub Get_Help(HelpTopic As Integer)
  209. Dim dummy$
  210.     If HelpTopic = MID_USING_HELP Then
  211.         '
  212.         ' "Using Help" was selected so display the Standard Windows Help
  213.         ' Topic for "Using Help".
  214.         '
  215.         WinHelp Editor.hWnd, dummy$, HELP_HELPONHELP, 0
  216.     Else
  217.         ' A help topic other the "Using help" was selected.
  218.         '
  219.         
  220.          WinHelp Editor.hWnd, HelpFilePath, HELP_CONTEXT, CLng(HelpTopic)
  221.     End If
  222.  
  223. End Sub
  224.  
  225. Function Help_File_In_Path()
  226. Dim Path As String, CurrentDir As String, SemiColon As Integer, Found